home *** CD-ROM | disk | FTP | other *** search
/ SunSoft Catalyst CDWARE 1996 May to August / Catalyst CDWARE 1996 May to August.iso / .products / .bin / httpd / Solaris_x86 / newwais.pl < prev    next >
Perl Script  |  1996-03-19  |  5KB  |  191 lines
  1. #!./perl
  2. #
  3. # newwais.pl -- WAIS search interface
  4. #
  5. # from wais.pl
  6. #
  7. # Tony Sanders <sanders@bsdi.com>, Nov 1993
  8. #
  9. # Example configuration (in local.conf):
  10. #     map topdir wais.pl &do_wais($top, $path, $query, "database", "title")
  11. #
  12. # this script uses a sneaky feature of Mosaic that interpretes a 
  13. # single text input form with the name 'isindex' (case sensitive) to
  14. # the same as a <ISINDEX>.  On non-mosaic clients, you wind up with an
  15. # additional query
  16. #
  17. # Note that I know even less about perl than the other two people
  18. # who hacked this, so feel free to send hate mail to pjh@netcom.com
  19. # if I did something really bad (or if there is a better way of
  20. # grabbing the filename off the end of a path.
  21. #
  22.  
  23. # parse disc name from ServerName Environt Variable with this script
  24.  
  25. do './variables.pl';
  26.  
  27. $oldLIB = $ENV{"LD_LIBRARY_PATH"};
  28. $ENV{"LD_LIBRARY_PATH"} = "$oldLIB:/usr/ucblib";
  29.  
  30. #require 'ctime.pl';
  31.  
  32. &get_request;
  33.  
  34. $waisq = "./waisq";
  35. $waisd = "/tmp/.wais/wais";
  36.  
  37.  
  38. $src = "catalyst_catalog";
  39. $title = "Example Data";
  40. #
  41. # file type map based on file extension, since all file types
  42. # come back type URL
  43. #
  44.  
  45. %filetype = (
  46. 'html', 'HTML File',
  47. );
  48.  
  49. #
  50. # code
  51. # 
  52.  
  53. sub send_index {
  54.     print "Content-type: text/html\n\n";
  55.     
  56.     print "<HEAD>\n<TITLE>Index of ", $title, "</TITLE>\n</HEAD>\n";
  57.     print "<BODY bgcolor=\"#DDDDDD\">\n<H1>", $title, "</H1>\n";
  58.  
  59.     print "This is an index of the information on this server. Please\n";
  60.     print "type a query in the search dialog.\n<P>";
  61.     print "You may use compound searches, such as: <CODE>environment AND cgi</CODE>\n";
  62.     print "<ISINDEX>";
  63. }
  64. sub get_request {
  65.  
  66.     if ($ENV{'REQUEST_METHOD'} eq "POST") {
  67.         read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
  68.     } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
  69.         $request = $ENV{'QUERY_STRING'};
  70.     }
  71.  
  72.  
  73.     @names = &url_decode(split(/[&=]/, $request));
  74.     %rqpairs = @names;
  75.  
  76. }
  77.  
  78. sub url_decode {
  79.  
  80. #       Decode a URL encoded string or array of strings
  81. #               + -> space
  82. #               %xx -> character xx
  83.  
  84.  
  85.     foreach (@_) {
  86.         tr/+/ /;
  87.         s/%(..)/pack("c",hex($1))/ge;
  88.     }
  89.     @_;
  90. }
  91.  
  92.  
  93. sub do_wais {
  94. #    local($top, $path, $query, $src, $title) = @_;
  95.  
  96. # strip the escape off of *'s
  97.     for (@ARGV){s/\\//g};
  98.  
  99.     local(@query) = $rqpairs{"isindex"};;
  100.  
  101.     local($pquery) = join(" ", @query);
  102.     local($nquery) = $pquery;
  103.     $nquery =~ tr/[A-Z]/[a-z]/;
  104.     if (!(($nquery =~ / and /) || ($nquery =~ / or /)))
  105.     {
  106.        $nquery =~ s/ //g;
  107.     }
  108. #
  109. # grab a wais source if there is one
  110. #
  111.  
  112.     local($test) = $ENV{'PATH_INFO'};
  113.     if ($test)
  114.     {
  115.     $test =~ s/\///;
  116.         $src = "catalyst_catalog";
  117.         $title = $test;
  118.     }
  119.  
  120.     close STDERR;
  121.     open(STDERR, ">/dev/null");
  122.  
  123.     print "Content-type: text/html\n\n";
  124.  
  125.     $ENV{'HOME'} = "/";
  126.     
  127.     open(WAISQ, "-|") || exec ($waisq, "-c", $waisd, "-m", 100,
  128.                                 "-f", "-", "-S", "$src.src", "-g", $nquery);
  129.  
  130.     print "<HEAD>\n<TITLE>Search of ", "Catalyst Catalog $disc_rest", "</TITLE>\n</HEAD>\n";
  131.     print "<img src=\"/.wais/images/goto_home.gif\">\n";
  132.     print "<BODY bgcolor=\"#DDDDDD\">\n<H1>Catalyst Catalog on $disc_name $disc_rest</H1>\n";
  133.  
  134.     print "<HR><FORM method=\"POST\" action=\"/cgi-bin/newwais.pl/$src\">\n";
  135.     print "Enter keyword(s):\n";
  136. #    print "<input name=\"isindex\" value=\"@query\" size=30></FORM><HR>\n";
  137.     print "<input name=\"isindex\" value=\"$pquery\" size=30></FORM><HR>\n";
  138.  
  139.     print "$title contains the following\n";
  140.     print "items relevant to <B>\`$pquery\':</B><P>\n";
  141.     print "<center>";
  142.     print "<table border=5>";
  143.     print "<DL>\n";
  144.     print "<th> Document Matched</th>";
  145.     print "<tr>\n";
  146.  
  147.  
  148.     local($hits, $score, $headline, $lines, $bytes, $type, $date);
  149.  
  150.     print "<OL>";
  151.     while (<WAISQ>) {
  152.         /:score\s+(\d+)/ && ($score = $1);
  153.         /:number-of-lines\s+(\d+)/ && ($lines = $1);
  154.         /:number-of-bytes\s+(\d+)/ && ($bytes = $1);
  155.         /:type "(.*)"/ && ($type = $1);
  156.         /:headline "(.*)"/ && ($headline = $1);         # XXX
  157.         /:date "(\d+)"/ && ($date = $1, $hits++, &docdone);
  158.     }
  159.     print "</table>";
  160.     print "</center>";
  161.  
  162.     print "</OL>";
  163.     close(WAISQ);
  164.     print "</DL>\n";
  165.  
  166.     if ($hits == 0) {
  167.         print "Nothing found.\n";
  168.     }
  169.     print "</BODY>\n";
  170. }
  171.  
  172.  
  173. sub docdone {
  174.  
  175.     if ($headline =~ /Search produced no result/) {
  176.         print "<HR>";
  177.     print "<h1>Search produced no result.</h1>";
  178.     } else {
  179.         $docname = $headline;
  180.     $docname =~ s/\.([^.]*)$//;
  181.     $extension= $1;
  182.     $docname =~ s/\/([^\/]*)$//;
  183.     $docname = $1;
  184.         print "<td><LI><A HREF=\"$headline\"><B>$docname</B></A></td>\n";
  185.     print "<tr>";
  186.     }
  187.     $score = $headline = $lines = $bytes = $type = $date = '';
  188. }
  189.  
  190. eval '&do_wais';
  191.